home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / Clipboard / ReadClip.p next >
Encoding:
Text File  |  1997-05-06  |  3.6 KB  |  158 lines
  1. Program ReadClip;
  2.  
  3. { ReadClip - liest Text aus dem Clipboard
  4.   Die Routine ist so geschrieben, daß sie leicht in
  5.   eigene Programme eingebaut werden kann.
  6.  
  7.   PUBLIC DOMAIN
  8.  
  9.   Andreas Tetzl     A.Tetzl@saxonia.de
  10. }
  11.  
  12. {$I "Include:Exec/Devices.i"}
  13. {$I "Include:Exec/IO.i"}
  14. {$I "Include:Devices/ClipBoard.i"}
  15. {$I "Include:Exec/Memory.i"}
  16. {$I "Include:Utils/IOUtils.i"}
  17. {$I "Include:DOS/DOS.i"}
  18. {$I "Include:Utils/StringLib.i"}
  19.  
  20. VAR Str : String;
  21.     err : Integer;
  22.  
  23. {///"FUNCTION CreateExtIO"}
  24. FUNCTION CreateExtIO( iop : MsgPortPtr; iosize : Integer) : Address;
  25. VAR
  26.     ExtIO : IOStdReqPtr;
  27.  
  28. Begin
  29.   If iop = NIl then CreateExtIO := NIL;
  30.   ExtIO := AllocMem( iosize, Memf_Public+Memf_Clear );
  31.   If ExtIO = NIL then CreateExtIO := NIL;
  32.  
  33.   With ExtIO^.io_message do begin
  34.     mn_node.ln_Type := NT_Message;
  35.     mn_Length := iosize;
  36.     mn_ReplyPort := iop;
  37.   End;
  38.   CreateExtIO := ExtIO;
  39. End;
  40. {///}
  41.  
  42. {///"PROCEDURE DeleteExtIO"}
  43. Procedure DeleteExtIO( iorp : IOStdReqPtr );
  44. Begin
  45.   With iorp^ do begin
  46.     io_Message.mn_node.ln_Type := $FF;
  47.     io_Device := Address( -1 );         { * Verstümmeln *}
  48.     io_Unit   := Address( -1 );
  49.   End;
  50.   FreeMem( iorp, iorp^.io_Message.mn_Length );  { * Speicher freigeben * }
  51. End;
  52. {///}
  53.  
  54. { /// ------------------------- "FUNCTION ReadClip" ------------------------- }
  55.  
  56. FUNCTION ReadClip(Unit : Byte; Buffer : String; BufferSize : Integer) : Integer;
  57.  
  58. { Parameter:
  59.     Unit : Unit des Clipboard.device (normalerweise 0)
  60.     Buffer : String, in den der Inhalt des Clipboards kopiert wird.
  61.     BufferSize : Größe des Buffers
  62. }
  63.  
  64. { Rückgabe:
  65.     0 : Alles OK
  66.     1 : Clipboard.device konnte nicht geöffnet werden
  67.     2 : Kein IFF-FTXT-File (kein Text im Clipboard)
  68.     3 : Nicht genug Speicher
  69. }
  70.  
  71. VAR err : Integer;
  72.     MyPort : MsgPortPtr;
  73.     MyReq  : IOClipReqPtr;
  74.     Chunk : String;
  75.     len, cklen : Integer;
  76.     buf : Address;
  77.  
  78. PROCEDURE Clip_Read(Buffer : Address; size : Integer);
  79. BEGIN
  80.  MyReq^.io_Command:=CMD_READ;
  81.  MyReq^.io_Data:=Buffer;
  82.  MyReq^.io_Length:=size;
  83.  err:=DoIO(MyReq);
  84. END;
  85.  
  86. Begin
  87.  StrCpy(Str,"");
  88.  
  89.  MyPort:=CreatePort(NIL,0);
  90.  If MyPort=NIL then ReadClip:=1;
  91.  
  92.  MyReq:=CreateExtIO(MyPort,SizeOf(IOClipReq));
  93.  If MyReq=NIL then
  94.   Begin
  95.    DeletePort(MyPort);
  96.    ReadClip:=1;
  97.   end;
  98.  
  99.  { Clipboard.device öffnen }
  100.  err:=OpenDevice("clipboard.device",UNIT,MyReq,0);
  101.  If err<>0 then
  102.   Begin
  103.    DeleteExtIO(IoStdReqPtr(MyReq));
  104.    DeletePort(MyPort);
  105.    ReadClip:=1;
  106.   end;
  107.  
  108.  Chunk:=AllocString(5);
  109.  
  110.  Clip_Read(Chunk,4);  { FORM-Kennung lesen }
  111.  Clip_Read(@len,4);   { Länge lesen }
  112.  len:=len+8;          { gesamte Dateilänge }
  113.  Clip_Read(Chunk,4);  { IFF-Typ lesen }
  114.  If StrEq(Chunk,"FTXT")=FALSE then
  115.   BEGIN
  116.    CloseDevice(MyReq);
  117.    DeleteExtIO(IoStdReqPtr(MyReq));
  118.    DeletePort(MyPort);
  119.    ReadClip:=2;
  120.   END;
  121.  
  122.  While MyReq^.io_Offset<len do
  123.   BEGIN
  124.    Clip_Read(Chunk,4);  { Chunk-Kennung lesen }
  125.    Clip_Read(@cklen,4); { Chunk-länge lesen }
  126.    buf:=AllocMem(cklen,MEMF_ANY);
  127.    If buf=NIL then ReadClip:=3;
  128.    Clip_Read(buf,cklen); { Daten lesen }
  129.  
  130.    If StrEq(Chunk,"CHRS") then  { CHRS-Chunk gefunden }
  131.     BEGIN
  132.      If cklen<buffersize then buffersize:=cklen;
  133.      StrnCpy(Buffer,buf,buffersize);  { Daten kopieren }
  134.     END;
  135.  
  136.    FreeMem(buf,cklen);          { Speicher freigeben }
  137.   END;
  138.  
  139.  CloseDevice(MyReq);
  140.  DeleteExtIO(IoStdReqPtr(MyReq));
  141.  DeletePort(MyPort);
  142. end;
  143.  
  144. { /// ------------------------------------------------------------------------ }
  145.  
  146. { /// -------------------------------- "Main" -------------------------------- }
  147.  
  148. BEGIN
  149.  Str:=AllocString(100);
  150.  
  151.  err:=ReadClip(0,Str,99);
  152.  
  153.  Writeln(Str);
  154.  FreeString(Str);
  155. END.
  156.  
  157. { /// ------------------------------------------------------------------------ }
  158.